home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d13 / oct90.arc / HSD.LSP < prev    next >
Lisp/Scheme  |  1990-11-01  |  8KB  |  194 lines
  1. ; HSD.LSP   [Article Figure 1]   (c)1990, Barry Bowen
  2.  
  3. ; ****************************** HSD.LSP **********************
  4. ; Copyright (c) Barry R. Bowen 1990
  5. ; -------------------------------------------------------------
  6. ; TOOLBOX ROUTINES USED:
  7. ; (E1),(E2),(E3)    Routines for entity handling (Sept '89)
  8. ; *ERROR*                Error handling routine  (Sept '89)
  9. ; (LS),(RL)       Routines for automatic layering (Feb '90)
  10. ; (S2),(S4)          Routines for selection-sets (Sept '89)
  11. ; (V1),(V1R)             System variable routines (Feb '89)
  12. ; (V3),(V4)          Start-up and ending routines (Feb '89)
  13. ; -------------------------------------------------------------
  14. ; Variables:
  15. ; ANS       = Variable for  questions
  16. ; CK        = Used in ADDL to get selection-set
  17. ; FILE      = File to open/write/read
  18. ; EN        = Entity name
  19. ; IN        = Counter
  20. ; INT       = Intersection of PT1, PT2 & line selected line
  21. ; LAYR      = Layer for lines to be dimensioned
  22. ; LINE      = One line in the file DIM and DIM1
  23. ; PT1 - PT5 = User selected points
  24. ; SS1       = Selection set crossing PT1 & PT2
  25. ; SS2       = Additional line and point selection-sets
  26. ; STL       = String length for MKPT
  27. ; TEMP      = Temporary variable
  28. ; X         = X point coordinate
  29. ; Y         = Y point coordinate
  30. ;--------------------------------------------------------------
  31. (defun C:HSD (/ ANS CK FILE EN INT IN LAYR LINE PT1 PT2     ; 1
  32.                 PT3 PT4 PT5 SS1 SS2 STL TEMP X Y)           ; 2
  33.  (V3)                                                       ; 3
  34.  (V1 '("dimse1" "dimse2" "flatland" "orthomode" "snapmode"  ; 4
  35.        "osmode"))                                           ; 5
  36.  (setvar "osmode" 0)                                        ; 6
  37.  (foreach N '("flatland" "orthomode" "dimse1" "dimse2")     ; 7
  38.    (setvar N 1))                                            ; 8
  39.  (setq IN 0                                                 ; 9
  40.      FILE (open "DIM" "w")                                  ;10
  41.       PT1 (getpoint "\nDimension Line First Point: ")       ;11
  42.       PT2 (getpoint PT1 "\nDimension Line Second Point:"))  ;12
  43.  (E1 "Select Line for Layer Check: ")                       ;13
  44.  (while (not EN)                                            ;14
  45.      (prompt "\nNo Line Selected-Try Again")                ;15
  46.      (E1 "Select Line: ")                                   ;16
  47.  )                            ;End While line 14            ;17
  48.  (E2)                                                       ;18
  49.  (E3 'LAYR 8)                 ;Get layer                    ;19
  50.  (setq SS1 (ssget "c" PT1 PT2))                             ;20
  51.  (S4 "LINE") ;Makes sure all entities are lines first       ;21
  52.  (S4A SS1)   ;Check Layers                                  ;22
  53.  (AUTO SS1)  ;Write points to file                          ;23
  54.  (ANSR "\nSelect Lines Not Crossing Intersection? <Y>: ")   ;24
  55.  (if (/= ANS "N") (ADDL))                                   ;25
  56.  (ANSR "\nSelect Lines Not On Selected Layer? <Y>: ")       ;26
  57.  (if (/= ANS "N")                                           ;27
  58.      (progn (setq CK T) (ADDL) (setq CK nil)))              ;28
  59.  (ANSR "\nAdd Additional Point Selections? <Y>: ")          ;29
  60.  (if (/= ANS "N")                                           ;30
  61.    (progn                                                   ;31
  62.      (setvar "blipmode" 1)                                  ;32
  63.      (setq TEMP (getpoint "\nSelect Point: "))              ;33
  64.      (while TEMP                                            ;34
  65.        (setq X (rtos (+ (car TEMP) 5000) 2 2)               ;35
  66.              Y (rtos (cadr TEMP) 2 2)                       ;36
  67.           LINE (strcat X "," Y "*")                         ;37
  68.           TEMP (getpoint "\nSelect Point: "))               ;38
  69.        (write-line LINE FILE)                               ;39
  70.      )                        ;End While line 34            ;40
  71.      (setvar "blipmode" 0)                                  ;41
  72.    )                          ;End Progn line 31            ;42
  73.  )                            ;End If line 30               ;43
  74.  (close FILE)                                               ;44
  75.  (command "type" "dim|sort>dim1")                           ;45
  76.  (setq FILE (open "DIM1" "r"))                              ;46
  77.  (CKPT)                       ;Get first point              ;47
  78.  (LS "DIM" 5 "")              ;Layer/Color/Linetype         ;48
  79.  (command "dim" "horiz" PT5)  ;First point                  ;49
  80.  (CKPT)                       ;Get next point               ;50
  81.  (command PT5 PT1 "")         ;Second point                 ;51
  82.  (EXTRA)                      ;Change color of text         ;52
  83.  (CKPT)                       ;Get next point               ;53
  84.  (setvar "dimse1" 1)          ;First Extension line off     ;54
  85.  (while (/= LINE nil)         ;Continue diminsioning        ;55
  86.    (command "continue" PT5 "");Dimension next point         ;56
  87.    (EXTRA)                    ;Change color of text         ;57
  88.    (CKPT)                     ;Get next point               ;58
  89.  )                            ;End While line               ;59
  90.  (command "exit")             ;Exit the DIM command         ;60
  91.  (close FILE)                 ;Close and end                ;61
  92.  (RL)                         ;Restore previous layer       ;62
  93.  (V1R)                        ;Restore system variables     ;63
  94.  (V4)                         ;Reset environment            ;64
  95. )                                                           ;65
  96.  
  97. ; ----------------------- CKPT --------------------------------
  98. (defun CKPT (/ STL)
  99.   (setvar "dimse2" 1)         ;Second Extendion line off
  100.   (setq LINE (read-line FILE));Read point from file
  101.   (if LINE
  102.    (progn
  103.       (setq STL (strlen LINE))
  104.       (if (= (substr LINE STL 1) "*")
  105.        (progn
  106.          (setq LINE (substr LINE 1 (1- STL)))
  107.          (MKPT LINE)
  108.          (setvar "dimse2" 0)
  109.       ))
  110.   ))
  111.  (if LINE (MKPT LINE))
  112. )
  113.  
  114. ; ----------------------- AUTO --------------------------------
  115. (defun AUTO (SST)
  116.   (setq IN 0 EN (ssname SST IN))
  117.   (while EN
  118.       (setq INT nil)
  119.       (E2)
  120.       (E3 'PT3 10)
  121.       (E3 'PT4 11)
  122.       (setq INT (inters PT1 PT2 PT3 PT4))
  123.    (if (not INT)
  124.     (progn
  125.      (setq INT1 (inters PT1 PT2 PT3 PT4 nil))
  126.        (if (> (distance INT1 PT3) (distance INT1 PT4))
  127.          (progn
  128.            (setq X (rtos (+ (car PT4) 5000) 2 2)
  129.                  Y (rtos (cadr PT4) 2 2)))
  130.          (progn
  131.            (setq X (rtos (+ (car PT3) 5000) 2 2)
  132.                  Y (rtos (cadr PT3) 2 2)))
  133.        )
  134.      (setq LINE (strcat X "," Y "*"))
  135.     )
  136.     (progn
  137.      (setq X (rtos (+ (car INT) 5000) 2 2)
  138.            Y (rtos (cadr INT) 2 2)
  139.         LINE (strcat X "," Y))
  140.    ))
  141.    (setq IN (1+ IN)
  142.          EN (ssname SST IN))
  143.    (write-line LINE FILE)
  144.   )
  145. )
  146.  
  147. ; ----------------------- ADDL --------------------------------
  148. (defun ADDL (/ SS2)
  149.   (prompt "\nSelect Additional Lines: ")
  150.   (setq SS2 (ssget))
  151.   (S4 "LINE")
  152.   (if (/= CK T) (S4A SS2))
  153.   (AUTO SS2)
  154. )
  155.  
  156. ; ------------------------ S4A --------------------------------
  157. (defun S4A (SSS / IN ELIST)
  158.   (setq IN 0)
  159.   (while (S2 'EN SSS)
  160.    (E2)
  161.    (if (= (E3 'ET 8) LAYR)
  162.         (setq IN (1+ IN))
  163.         (ssdel EN SSS))
  164.   )
  165. )
  166.  
  167. ; ----------------------- EXTRA -------------------------------
  168. (defun EXTRA ()
  169.   (if (= (getvar "dimaso") 0)
  170.     (progn
  171.       (command "exit"
  172.                "change" (entlast) "" "p" "c" "7" ""
  173.                "dim")
  174.   ) )
  175. )
  176.  
  177. ; ----------------------- MKPT --------------------------------
  178. (defun MKPT (A)
  179.   (setq X "")
  180.   (while (and (/= "" A) (/= "," (substr A 1 1)))
  181.     (setq X (strcat X (substr A 1 1))
  182.           A (substr A 2 (strlen A)))
  183.   )
  184.   (setq Y (read (substr A 2 (- (strlen X) 1)))
  185.         X (- (read X) 5000)
  186.       PT5 (list X Y))
  187. )
  188.  
  189. ; ----------------------- ANSR --------------------------------
  190. (defun ANSR (PRMT)
  191.   (initget "Y N")
  192.   (setq ANS (getkword PRMT))
  193. )
  194.